VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "HTMLReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
''Copyright 2010 Alliance Global Services, Inc. All rights reserved.
''Any redistribution or reproduction of part or all of the contents in any form is prohibited.
''You may not, except with our express written permission, distribute or commercially exploit the content.
''Nor may you transmit it or store it in any other form of electronic retrieval system.


'========================================================================================================
'Author :K.R.Kishore Kumar
'========================================================================================================

Private gsResultFile                         ' Contains Result File name
Private gsResultPath
Private gsTitle
Private giPassCount
Private giFailCount
Private giWarningCount
Private giStepCount
Private gpStartDate
Private gpStartTime
Private gpStopTime
Private gpStopDate
Private gNow                     'Contains current date& time
Private LF                       'Line Feed character
Private CRLF                     'Carriage Return + Line Feed character
Private DQ                       'Double Quotes character
Private BSLASH                   'Backslash character
Public gbCreateHTMLReport        ' Contains TRUE or FALSE to Enable/disable HTML Creation
Private iReadFlag
Private gResultFolder
Private gsObservationText
Private gsObservationFile
Private gsTestSummaryFile
Private gsTestSummaryText
Private WSHShell
Private gLogLevel

Private Const gPass = 0                          'A pass in the result logs
Private Const gFail = 1                          'A fail in the result logs
Private Const gDone = 2                          'A comment in the result logs
Private Const gWarning = 3
Private Const giAbort = 4                        'A warning in the result logs
Private Const gStart = 5
Private Const gInfo = 6
Private Const gTrace = 7
Private Const gDebug = 8
Private Const gError = 8
Private Const ForReading = 1
Private Const ForWriting = 2
Private Const ForAppending = 8
Private Const E_OK = 0
Private Const E_FAIL = 1
Private fso, TestDir

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long


'====================================================================
'Function       : SetProject(in sProject,in ResultPath)
'DESCRIPTION    :
'Author         : K.R.Kishore Kumar
'Date           : 12-July-2011
'USAGE          :
'====================================================================
Public Function SetProject(ByVal sProject, ByVal ResultPath)
 Dim sQTestname
 
giPassCount = 0
giFailCount = 0
giWarningCount = 0

gpStartDate = Date
gpStartTime = Time
gsResultPath = ResultPath


    'strTemp= split(Parameter("Automation_ID"),"_")
    If InStr(sProject, ";") > 0 Then
        sTemp = Split(sProject, ";")
        gsTitle = sTemp(0)
        sProject = gsTitle
        sQTestname = sTemp(1)
    Else
        sQTestname = "Module" 'strTemp(1)
        gsTitle = sProject
    End If
    iReadFlag = 0
    
    ' Call Function Create_ResultFolder() to create the Results Folder
    strPath = Create_ResultFolder()
    
    'gsObservationFile=gsResultPath & "\Observations_" &  sQTestName(1) & "_Log " & day(now) & month(now)&year(now)& Hour(now) & minute(now)&second(now) & "_" & Environment("UserName") & ".html"
    gsResultFile = sProject & "_ " & sQTestname & "_Log_" & fnUniqueTime() '& "_" & Environment("UserName")
    gsTestSummaryFile = gsResultPath & "\" & sProject & "_" & sQTestname & "_TestSummary_Log_" & fnUniqueTime() & ".html"
    
    giPassCount = 0
    giFailCount = 0
    giWarningCount = 0
    giStepCount = 0
    gNow = Now
    gpStartDate = Date
    gpStartTime = Time
    gLogLevel = "INFO"
    
    If UCase(gbCreateHTMLReport) = True Then
        Call CreateHTMLLog(gsProject)
    End If
    
    SetProject = strPath
End Function

'====================================================================
'Function       : LogMessage(ByVal iType, ByVal sMsg, ByVal sExtended )
'DESCRIPTION    : sends output messages to  HTML Report
'Author         : K.R.Kishore Kumar
'Date           : 12-July-2011
'USAGE          :
'====================================================================
Public Function LogMessage(ByVal iType, ByVal sMsg, ByVal sExtended)
On Error GoTo Here
Dim sStatus
Dim sColor


Select Case iType
Case gPass
   
    sColor = "GREEN"
    sStatus = "Pass"
    giPassCount = giPassCount + 1
    giStepCount = giStepCount + 1
Case gFail
   
    sColor = "RED"
    sStatus = "Fail"
    giFailCount = giFailCount + 1
    giStepCount = giStepCount + 1
Case gWarning
   
    sColor = "BLUE"
    sStatus = "Warning"
    giWarningCount = giWarningCount + 1
    giStepCount = giStepCount + 1
Case gDone
    sStatus = ""
    sColor = "BLACK"
    giStepCount = giStepCount + 1

Case gInfo
    sStatus = "Info"
    sColor = "BLACK"
    giStepCount = giStepCount + 1

Case gAbort
    sColor = "RED"
    sStatus = "ERROR"
    giFailCount = giFailCount + 1
   
    If UCase(gbCreateHTMLReport) = True Then
        Call WriteToHTMLTable(sColor, sStatus, sMsg, sExtended)
    End If
    Call Summarize_Results("", "", "")
  
Case gStart
    sStatus = "START"
    sColor = "#990033"
    sMsg = "<B>" & sMsg & "</B>"
    sExtended = "<B>" & sExtended & "</B>"
End Select
    
    If UCase(gbCreateHTMLReport) = True Then
        Call WriteToHTMLTable(sColor, sStatus, sMsg, sExtended)
    End If
    Exit Function
Here:
    MsgBox Err.Description & ":" & Err.Source
    
     
End Function

'====================================================================
'
'DESCRIPTION: Creates the header of  HTML log results file

'Author :K.R.Kishore Kumar

'USAGE: CreateHTMLLog( sSuiteName )

'where sSuiteName is the name of the test suite
'
'===================================================================
Private Function CreateHTMLLog(ByVal sSuiteName)

On Error GoTo ERR_Handler
    Dim oOutFile
    Dim sAppendText
    Dim WSHShell, strRegKey1
    
    If iReadFlag = 0 Then
        gsResultFile = gsResultPath & BSLASH & gsResultFile & ".HTML"

    Else
        sAppendText = "<TABLE WIDTH='100%' BORDER=1 BORDERCOLOR='#FFFFFF' CELLSPACING='0' CELLPADDING='0' STYLE='Font-Size:12pt   Border-Colapse: Colapse'>" & CRLF
        sAppendText = sAppendText & "<Thead BGCOLOR='#009968' STYLE='Font-Weight: Bold   Color: #FFFFFF'>" & CRLF
        sAppendText = sAppendText & "<th width=" & DQ & "15%" & DQ & "> Time </th>" & CRLF
        sAppendText = sAppendText & "<th width=" & DQ & "8%" & DQ & "> Step No# </th>" & CRLF
        sAppendText = sAppendText & "<th width=" & DQ & "7%" & DQ & ">Status</th>" & CRLF
        sAppendText = sAppendText & "<th width=" & DQ & "33%" & DQ & ">Details</th>" & CRLF
        sAppendText = sAppendText & "<th width=" & DQ & "37%" & DQ & ">Additional Information</th>"
        sAppendText = sAppendText & "</thead>" & CRLF
        sAppendText = sAppendText & "<tbody>" & CRLF
        'Write text to file
       gsObservationText = ""
       gsTestSummaryText = ""
       Call CreateFile(sAppendText, ForAppending)
       Exit Function
       
    End If

    sAppendText = ""
    gsObservationText = ""
    gsTestSummaryText = ""
    sAppendText = "<Html>" & CRLF & "<head>" & CRLF
    sAppendText = sAppendText & "<meta http-equiv=" & DQ & "Content-Type" & DQ & " content=" & DQ & "text/html   charset=windows-1252" & DQ & ">" & CRLF
    sAppendText = sAppendText & "<title>" & gsTitle & " Automated Results</title>" & CRLF
    sAppendText = sAppendText & "</head>" & CRLF & "<BODY STYLE='Font-Family: Palatino Linotype' Bgcolor=#F5F6CE>" & CRLF
    'sAppendText = sAppendText & "<Table width=100%><TH width=30%><Marquee><img src='" & getvar("testname") & "\logo.gif' align=\"left\"> </IMG></MARQUEE></TH>"
    'gsObservationText=sAppendText

    gsTestSummaryText = sAppendText & "<font color=" & DQ & "BLUE" & DQ & " size=6><Center>" & gsTitle & "  <br>Automated Test Summay Report</Center></font></center>" & CRLF
    sAppendText = sAppendText & "<TH><font color=" & DQ & "BLUE" & DQ & " size=6><Center>" & gsTitle & " Log <br>AUTOMATED TEST RESULTS</Center></font> </Th></center></Table>" & CRLF
    sAppendText = sAppendText & "<Table width=100%><TR><TD><B>HTML Results  FILE :</B> " & gsResultFile & "<TD><br>" & CRLF
    sAppendText = sAppendText & "<TD><B>Created On : </B>" & Now() & "</TD></TR></Table>" & CRLF

     Call CreateFile(sAppendText, ForWriting)
       
     strMachineInfo = Get_Machine_Info()
     
     'gsObservationText=gsObservationText&& "<TH><font color=" & DQ & "BLUE" & DQ & " size=6><Center>MediaPro Error Log <br>AUTOMATED TEST RESULTS </Center></font> </Th></center></Table>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "<Table width=100%><TR><TD>HTML RESULTS LOG FILE = " & gsResultFile & "</TD>"
     gsTestSummaryText = gsTestSummaryText & "<TD><B>Created On :</B> " & Now() & "</TD></TR></Table>" & CRLF
     gsTestSummaryText = gsTestSummaryText & strMachineInfo
     gsTestSummaryText = gsTestSummaryText & "<TABLE WIDTH='100%' BORDER=1 BORDERCOLOR='#FFFFFF' CELLSPACING='0' CELLPADDING='0' STYLE='Font-Size:12pt   Border-Colapse: Colapse'>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "<Thead BGCOLOR='#009968' STYLE='Font-Weight: Bold   Color: #FFFFFF'>" & CRLF
    
     gsTestSummaryText = gsTestSummaryText & "<th width=" & DQ & "20%" & DQ & ">Automation ID</th>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "<th width=" & DQ & "20%" & DQ & ">Scenario ID</th>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "<th width=" & DQ & "30%" & DQ & ">Manual Test Cases Covered</th>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "<th width=" & DQ & "15%" & DQ & ">Status</th>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "<th width=" & DQ & "15%" & DQ & ">Execution Time</th>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "</thead>" & CRLF
     gsTestSummaryText = gsTestSummaryText & "<Tbody>" & CRLF

     Write_to_TestSummaryReport gsTestSummaryText, ForWriting


     'sAppendText = "<p>HTML RESULTS LOG FILE = " & gsResultFile & "<br>" & CRLF
     'sAppendText = sAppendText & "<br><font color=#aa2233><h4>Created On : " & Now() & "</h4></Font></p>" & CRLF
     sAppendText = "<TABLE WIDTH='100%' BORDER=1 BORDERCOLOR='#FFFFFF' CELLSPACING='0' CELLPADDING='0' STYLE='Font-Size:12pt   Border-Colapse: Colapse'>" & CRLF
     sAppendText = sAppendText & "<Thead BGCOLOR='#009968' STYLE='Font-Weight: Bold   Color: #FFFFFF'>" & CRLF
     sAppendText = sAppendText & "<th width=" & DQ & "12%" & DQ & ">Time</th>" & CRLF
     sAppendText = sAppendText & "<th width=" & DQ & "8%" & DQ & ">Step No#</th>" & CRLF
     sAppendText = sAppendText & "<th width=" & DQ & "7%" & DQ & ">Status</th>" & CRLF
     sAppendText = sAppendText & "<th width=" & DQ & "33%" & DQ & ">Details</th>" & CRLF
     sAppendText = sAppendText & "<th width=" & DQ & "40%" & DQ & ">Additional Information</th>"
     sAppendText = sAppendText & "</thead>" & CRLF
     sAppendText = sAppendText & "<Tbody>" & CRLF
     gsObservationText = sAppendText
     
     Call CreateFile(sAppendText, ForAppending)
     
     Exit Function
 
ERR_Handler:
    MsgBox Err.Description & Err.Source & ":" & Err.Number
    
End Function
'==========================================================================================================
'DESCRIPTION        : Add a line (table row) to our HTML results log
'AUTHOR             : K.R.Kishore Kumar
'DATE               : 13/July/2011
'USAGE              : WriteToHTMLTable( sColor, sStatus, sMsg, sExtended )
'               where sColor is the color to write in
'               sStatus is PASS, FAIL, WARNING or ABORT
'               sMsg is the message to write
'               sExtended is additional logging information
'EXAMPLE: WriteToHTMLTable( sColor, sStatus, sMsg, sExtended )
'NOTES: Called by LogMessage()
' Rewritten to do just one write to the results file and to use the common library to do the writing
'=========================================================================================================
Private Function WriteToHTMLTable(ByVal sColor, ByVal sStatus, ByVal sMsg, ByVal sExtended)

On Error GoTo Here
    Dim oOutFile                                          'Output (log) file object
    Dim sTime                                              'Current time
    Dim iHour                                              'Current hour
    Dim sHour                                              'Current hour in text format
    Dim sAppendText                                  'Text to append to the results log
    Dim strScreenData

    
    
    strScreenData = ""

     'Start of row
     'sAppendText = "<TR bgcolor=#EEEEEE>"
     gsObservationText = ""
    gLogLevel = "INFO" '' Added for testing
     'Table Column 1 - Time
     'Each time part needs to be 2 digits long
    ' sTime = qtApp.DotNetFactory.CreateInstance("System.DateTime").Now.ToString("hh:mm:ss.fff tt") 'time in seconds
      sTime = TimeToMillisecond
    If Len(Trim(sMsg)) = 0 And Len(Trim(sExtended)) = 0 Then
        sTime = "&nbsp"
        sStatus = ""
    End If
        'AppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
        'Table Column 2 - Status
        If Len(Trim(sStatus)) = 0 Then
             sStatus = "&nbsp;"     'Blank cell
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">  &nbsp </FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
        ElseIf UCase(Trim(sStatus)) = "START" Then
            sStatus = "&nbsp;"     'Blank cell
            If InStr(UCase(sMsg), "START") > 0 Then
                sAppendText = "<TR bgcolor=#9EEEEE>"
            Else
                sAppendText = "<TR bgcolor=#EEEEEE>"
            End If
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
        ElseIf UCase(Trim(sStatus)) = "HEADER" Then
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
        ElseIf UCase(Trim(gLogLevel)) = "INFO" And UCase(Trim(sStatus)) = "INFO" Then
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><Center><font color=" & sColor & ">" & giStepCount & "</font></Center></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> Info</font></td>" & CRLF
        ElseIf UCase(Trim(gLogLevel)) = "DEBUG" And UCase(Trim(sStatus)) = "DEBUG" Then
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><Center><font color=" & sColor & ">" & giStepCount & "</font></Center></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp;</font></td>" & CRLF
        ElseIf UCase(Trim(gLogLevel)) = "TRACE" And UCase(Trim(sStatus)) = "TRACE" Then
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & ">" & sStatus & "</font></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
        ElseIf UCase(Trim(gLogLevel)) = "ERROR" And UCase(Trim(sStatus)) = "ERROR" Then
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & ">" & sStatus & "</font></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & "> &nbsp; </font></td>" & CRLF
        ElseIf UCase(sStatus) = "FAIL" Then
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><Center><font color=" & sColor & ">" & giStepCount & "</font></Center></td>" & CRLF
            '''''''''''''''''***************************Failure Log**************************************''''''''''''''''''''''''''''''''
            ''gsObservationText=sAppendText & "<td><font color=" & sColor & ">" & sStatus & "</font></td>" & CRLF
            ''gsObservationText=gsObservationText & "<td><font color='" & sColor & "'>" & sMsg & "</font></td>" & CRLF
            ''gsObservationText=gsObservationText & "<td><font color='" & sColor & "'>" & sExtended & "</font></td>" & CRLF
            ''gsObservationText=gsObservationText & "</tr>" & CRLF
            '''''''''''''''*****************************Failure Log **************************************''''''''''''''''''''''''''''''''
            sAppendText = sAppendText & "<td><font color=" & sColor & "><Marquee Direction=Right>" & sStatus & "</Marquee></font></TD>" & CRLF
            strTemp = Split(sExtended, "@@")
            strScreenShotPath = Split(strTemp(1), ";")
            sExtended = strTemp(0) & "<BR> <A href=" & strScreenShotPath(0) & "> Click Here To View Screenshot</a>. FileName: " & strScreenShotPath(1)
        ElseIf UCase(sStatus) = "PASS" Or UCase(sStatus) = "WARNING" Then
            sAppendText = "<TR bgcolor=#EEEEEE>"
            sAppendText = sAppendText & "<TD><font color=" & sColor & ">" & sTime & "</FONT></TD>" & CRLF
            sAppendText = sAppendText & "<td><Center><font color=" & sColor & ">" & giStepCount & "</font></Center></td>" & CRLF
            sAppendText = sAppendText & "<td><font color=" & sColor & ">" & sStatus & "</font></td>" & CRLF
        Else
            Exit Function
        End If
           
        'Table Column 3 - Details
        If Len(sMsg) = 0 Then
            sMsg = "&nbsp;"   'blank cell
        End If

    
        sAppendText = sAppendText & "<td><font color='" & sColor & "'>" & sMsg & "</font></td>" & CRLF
    
        'Table Column 4 - Additional detail
        If Len(sExtended) = 0 Then
            sExtended = "&nbsp;"   'blank cell
        End If

        'If UCase(Trim(sStatus)) <> "HEADER" And UCase(Trim(sStatus)) <> UCase("&nbsp;") Then
        '    strScreenData = fnscreenShot("")
        'End If
        
        sAppendText = sAppendText & "<td><font color='" & sColor & "'>" & sExtended & "</font><BR> " & strScreenData & "</td>"
    
        'End of row
        sAppendText = sAppendText & "</tr>" & CRLF
    
    'Write text to file
    CreateFile sAppendText, ForAppending
    gsObservationText = ""
    Exit Function
Here:
    MsgBox Err.Description & Err.Source

End Function
        

Private Function Get_Machine_Info()
On Error GoTo Here
    Dim objNet, fso, F, WSHShell, sComputer, oWMIService, oItem, propValue, SWBemlocator, cItems, str
    Dim gsRC
    Dim gsUserId
    Dim gsVender
    Dim gsProcessor
    Dim gsOS
    Dim gsRAM
    Dim QTPVersion
    
    Set WSHShell = CreateObject("WScript.Shell")
    gsVender = WSHShell.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\VendorIdentifier")
    gsProcessor = WSHShell.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\Identifier")
    gsProcessor = WSHShell.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\ProcessorNameString")
    QTPVersion = WSHShell.RegRead("HKEY_CURRENT_USER\Software\Mercury Interactive\QuickTest Professional\MicTest\TulipAppInfo\Version")
    
    Set objNet = CreateObject("WScript.NetWork")
    UserID = objNet.UserName
    HostName = objNet.ComputerName
    Domain = objNet.UserDomain
    Set objNet = Nothing
    
    
    IEVersion = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\Version"
    IEVersion = WSHShell.RegRead(IEVersion)
    gsOS = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName") & WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentBuildNumber")
    
    
    For Each instance In GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
        gsRAM = Round(instance.TotalPhysicalMemory / 1048576, 0) & "MB"
    Next
    
    
    str = "<TABLE bgcolor=teal WIDTH='100%' BORDER=1 BORDERCOLOR='#FFFFFF' CELLSPACING='0' CELLPADDING='0' STYLE='Font-Size:12pt   Border-Colapse: Colapse'>"
    str = str & "<TH><font color='YELLOW'>Test Machine Information</font></tH><Table>"
    str = str & "<TABLE WIDTH='100%' BORDER=2 BORDERCOLOR='#FFFFFF' CELLSPACING='0' CELLPADDING='0' STYLE='Font-Size:12pt   Border-Colapse: Colapse'>"
    str = str & "<td><font color='BLACK'>"
    
    str = str & "<TR><TD><B>UserName : </B>" & UserID & "</TD>" & CRLF
    str = str & "<TD><B>Host :</B>" & HostName & "@" & Domain & "</TD></TR>" & CRLF
    str = str & "<TR><TD><B>Operating System : </B>" & gsOS & "</TD>" & CRLF
    'str = str & "<TD><B>CPU: </B>" & gsVender & "&nbsp; & &nbsp;" & gsProcessor & "<BR><B>Physical Memory :</B> " & gsRAM & "</TD></TR>" & CRLF
    str = str & "<TD><B>CPU: </B>" & gsProcessor & "<BR> <B>Physical Memory :</B> " & gsRAM & "</TD></TR>" & CRLF
    'str = str & "<TR><TD><B>Physical Memory :</B> " & gsRAM & "</TD>" & CRLF
    str = str & "<TR><TD><B>IE version : </B>" & IEVersion & "</TD>" & CRLF
    str = str & "<TD><B>" & "QTP Version : " & "</B>" & QTPVersion & "</TD></TR></Table>" & CRLF
    str = str & "<HR width=100% color='teal'>" & CRLF
    CreateFile str, ForAppending
    Get_Machine_Info = str
     
        
Exit Function
    
Here:
    MsgBox " in machine info :" & Err.Description & Err.Number

End Function

'========================================================================================================
'DESCRIPTION: Add a summary to our HTML results log and end table
'AUTHOR:K.R.Kishore Kumar
'DATE: 20/July/2011
'USAGE: Summarize_Results()
'EXAMPLE: Summarize_Results()
'=======================================================================================================
Public Function Summarize_Results(ByVal gsAutomationID, ByVal gsScenarioID, ByVal gsManualTestCase)

   Dim vStopDate   'Stop test clock - date
    Dim vStopTime   'Stop test clock - time
    Dim sDuration   'Test duration
    Dim lTotalSecs  'Total seconds duration
    Dim iSecs   'Seconds duration in HH:MM:SS
    Dim iMins   'Minutes duration in HH:MM:SS
    Dim iHours  'Hours duration in HH:MM:SS
    
    gNow = Now              'Current Date & Time
    
    vStopDate = Date
    vStopTime = Time
    
    lTotalSecs = Abs(DateDiff("s", gpStartTime, vStopTime) + (DateDiff("d", gpStartDate, vStopDate) * 86400))
    iHours = Abs(CInt(lTotalSecs / 3600))
    lTotalSecs = Abs(lTotalSecs - (3600 * iHours))
    iMins = Abs(CInt(lTotalSecs / 60))
    lTotalSecs = Abs(lTotalSecs - (60 * iMins))
    iSecs = Abs(CInt(lTotalSecs))
    sDuration = iHours & ":" & iMins & ":" & iSecs
    'Reporter.Filter=rfEnableAll
        
    'Only write to text file if we specifically say we want to
     If UCase(gbCreateHTMLReport) = "TRUE" Then
        
        'Write to HTML file
        'Print the summary lines in BOLD DARK PURPLE in the html report
        
        WriteToHTMLTable "#800080", "", "<b>TOTAL NUMBER OF PASSES = " + CStr(giPassCount) + "</b>", ""
        WriteToHTMLTable "#800080", "", "<b>TOTAL NUMBER OF FAILURES = " + CStr(giFailCount) + "</b>", ""
        WriteToHTMLTable "#800080", "", "<b>TOTAL NUMBER OF WARNINGS = " + CStr(giWarningCount) + "</b>", ""
        WriteToHTMLTable "#800080", "", "<b>TOTAL ELAPSED TIME (HH:MM:SS) = " + sDuration + "</b>", ""
        sAppendText = "</tbody><BR></table><BR></body><BR></html>"


        If CInt(giFailCount) = 0 And CInt(giWarningCount) = 0 Then
            strStatus = "Pass"
            sColor = "Green"
        ElseIf CInt(giFailCount) = 0 And CInt(giWarningCount) > 0 Then
            strStatus = "Pass"
            sColor = "Green"
        ElseIf CInt(giFailCount) = 0 And CInt(giWarningCount) = 1 Then
            strStatus = "Skipped"
            sColor = "Black"
        ElseIf CInt(giFailCount) > 0 Then
            strStatus = "Fail"
            sColor = "Red"
        End If

      gsTestSummaryText = "<TR><TD><font color='" & sColor & "'>" & gsAutomationID & "</font></td>" & CRLF
      gsTestSummaryText = gsTestSummaryText & "<td><Center><font color='" & sColor & "'>" & gsScenarioID & "</font></Center></td>" & CRLF
      gsTestSummaryText = gsTestSummaryText & "<td><Center><font color='" & sColor & "'>" & gsManualTestCase & "</font></Center></td>" & CRLF
      gsTestSummaryText = gsTestSummaryText & "<td><Center><font color='" & sColor & "'>" & strStatus & "</font></Center></td>" & CRLF
      gsTestSummaryText = gsTestSummaryText & "<td><Center><font color='" & sColor & "'>" & sDuration & "</font></Center></td></TR>" & CRLF

      Write_to_TestSummaryReport gsTestSummaryText, ForAppending
    
        gsObservationText = ""
    
        'Write text to file
        CreateFile sAppendText, ForAppending
    End If
Summarize_Results = sDuration

End Function

Private Sub CreateFile(ByVal sText, ByVal iFileMode)
   Dim fso, tf
  
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set tf = fso.OpenTextFile(gsResultFile, iFileMode, True)
    tf.WriteLine (sText)
    tf.Close
    Set tf = Nothing
    Set fso = Nothing
    
End Sub

Private Sub Class_Initialize()

giPassCount = 0
giFailCount = 0
giWarningCount = 0

gvStartDate = Date
gvStartTime = Time

CR = Chr(13)
LF = Chr(10)
CRLF = CR + LF
DQ = Chr(34)
BSLASH = Chr(92)

' Set the Shell object and use the device replay object
Set WShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

End Sub
'##############################################################################################################
'       Function Name           :  Write_to_TestSummaryReport(byval sText,byval iFileMode)
'       Purpose                 : This function is used to Writing to Test Sumary  File ,Writes Scenario Status
'       Pre-Condition           :
'
'       Created By              : Kishore Kambham
'       Date                    : 07/05/2010
'       Reviewed By             : Srinivas Rao Labhani
'       Reviewed On             :
' ###############################################################################################################
Private Function Write_to_TestSummaryReport(ByVal sText, ByVal iFileMode)
     Set fso = CreateObject("Scripting.FileSystemObject")
   ''Writing to Test Sumary  File ,Writes Scenario Status
        Set tf2 = fso.OpenTextFile(gsTestSummaryFile, iFileMode, True)
        If Trim(sText) <> "" Then
            tf2.WriteLine sText
       End If
        tf2.Close
        Set tf2 = Nothing
        Set fso = Nothing
        
End Function
'##############################################################################################################
'       Function Name               :  GetResultFile()
'       Purpose                     : This function is used to Create the header of TABLE file.
'       Pre-Condition               :
'
'       Created By                  : Kishore Kambham
'       Date                        :
'       Reviewed By                 : Srinivas Rao Labhani
'       Reviewed On                 :
' ###############################################################################################################
Public Sub GetResultFile()
iReadFlag = 1
giPassCount = 0
giFailCount = 0
giWarningCount = 0
giStepCount = 0
gNow = Now              'Current Date & Time
gpStartDate = Date
gpStartTime = Time

If UCase(gbCreateHTMLReport) = True Then
    Call CreateHTMLLog("")
End If

End Sub

'##############################################################################################################
'       Function Name           : fnscreenShot(HWND)
'       Purpose                 : This is function captures screenshot whenever error occurs & appends as a link in HTML File
'       Pre-Condition           :
'
'       Created By              : Kishore Kambham
'       Date                    : 07/05/2010
'       Reviewed By             : Srinivas Rao Labhani
'       Reviewed On             :
' ###############################################################################################################
Private Function fnscreenShot(hWnd)
  On Error Resume Next
    Dim strFilename

    strTCName = "Screenshot" 'objExcel("Automation_ID")

    strFilename = strTCName & "_" & fnUniqueTime()
                
    strPath = gsResultPath & "\" & strFilename & ".bmp"
    MsgBox strPath
    strTemp = Split(UCase(gsResultFile), "\")
    
    Desktop.CaptureBitmap strPath

    strPath1 = "..\" & strTemp(3) & "\" & strFilename & ".png"

    
Dim x As Integer, y As Integer, nWidth As Integer, nHeight As Integer
  Dim dwRop As Long, hSrcDC As Long, hDestDC As Long
  Dim strFName As String

    Dim strTime As String ' part of the file name
    strTime = Replace(Now, "/", "_")
    strTime = Replace(strTime, ":", "_")
    strTime = Replace(strTime, " ", "_")
    Picture1.Width = Screen.Width
    Picture1.Height = Screen.Height
    
    strFName = "Peek_pic" & strTime & ".bmp"
    Let nWidth = Screen.Width
    Let nHeight = Screen.Height
    Let dwRop = SRCCOPY
    Let hDestDC = Picture1.hdc
    Let hSrcDC = GetDC(0)
    Call BitBlt(hDestDC, 0, 0, nWidth, nHeight, hSrcDC, 0, 0, dwRop)
    Call ReleaseDC(0, hSrcDC)
    Picture1.FontName = "Tahoma"
    Picture1.FontSize = "16.5"
    Picture1.FontBold = True
    Picture1.Print Date & " " & Time
    SavePicture Picture1.Image, strPath
    'LogMessage gDone,"Captured ScreenShot For Browser/Window : ","<B>"&strBrowserName&"- </B> "&"<A href=" & strPath & ">Click Here To View Screenshot</a>. FileName: " & strFilename &".png "
    fnscreenShot = "<A href=" & strPath & ">Click Here To View Screenshot</a>. FileName: " & strFilename & ".png "
    On Error GoTo 0

End Function

'##############################################################################################################
'       Function Name           : Create_ResultFolder()
'       Purpose                 : This is function is used to create a results folder
'       Pre-Condition           :
'
'       Created By              : Kishore Kambham
'       Date                    : 07/05/2010
'       Reviewed By             : Srinivas Rao Labhani
'       Reviewed On             :
' ###############################################################################################################
Private Function Create_ResultFolder()
Set objFSO = CreateObject("Scripting.FileSystemObject")
strMonth = Month(Date)

If Len(strMonth) = 1 Then
    strMonth = "0" & strMonth
End If

strDay = Day(Date)

If Len(strDay) = 1 Then
    strDay = "0" & strDay
End If

strYear = Year(Date)
gResultFolder = strMonth & "_" & strDay & "_" & strYear
gsResultPath = gsResultPath & strMonth & "_" & strDay & "_" & strYear

If Not objFSO.FolderExists(gsResultPath) Then
  objFSO.CreateFolder (gsResultPath)
  
End If
Create_ResultFolder = gsResultPath
End Function
'##############################################################################################################
'       Function Name            :  ReadFile()
'       Purpose                  : This is function is used to Read the file from the specified location
'       Pre-Condition            :
'
'       Created By              : Kishore Kambham
'       Date                    : 07/05/2010
'       Reviewed By             : Srinivas Rao Labhani
'       Reviewed On             :
' ###############################################################################################################
Private Function ReadFile()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tf = fso.OpenTextFile(WSHShell.ExpandEnvironmentStrings("%Temp%") & "\Temp.txt", ForReading)
    strLine = tf.ReadLine
    KeyValue = Split(strLine, ",")
    strStatus = KeyValue(1)
    tf.Close
    Set tf = Nothing
    Set fso = Nothing
    
    'ReadFile = strStatus
End Function
'##############################################################################################################
'       Function Name           :  fnUniqueTime()
'       Purpose                 : This function is used to Generate & retun unique random number
'       Pre-Condition           :
'
'       Created By              : Kishore Kambham
'       Date                    : 07/05/2010
'       Reviewed By             : Srinivas Rao Labhani
'       Reviewed On             :
' ###############################################################################################################
Public Function fnUniqueTime()
    fnUniqueTime = Year(Date) & Month(Now) & Day(Date) & Hour(Now) & Minute(Now) & Second(Now)
End Function

Private Sub Class_Terminate()
Set WSHShell = Nothing
End Sub

Private Function TimeToMillisecond() As String
On Error Resume Next
Dim sAns As String
Dim typTime As SYSTEMTIME

GetSystemTime typTime
sAns = Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & ":" & typTime.wMilliseconds
TimeToMillisecond = sAns

End Function

